BBS Toolkit/BBS Toolkit.iso/qbbs/qktmbps.zip/QKTMBPS.PAS

Pascal/Delphi Source File | 1990-08-16 | 7KB | 277 lines

Program QkTmBPS;

Uses Dos, OpCRT, OpString, OpDate;

Type

  CommandRec = record
    Baud     : string[4];
    Day      : string[4];
    STime    : Time;
    ETime    : Time;
  end;

  EventRec = record
    Tag      : string[15];
    Commands : array[1..10] of CommandRec;
  end;

var
  EventOK  : boolean;
  x, y, TagNo : byte;
  sTemp    : string;
  F        : Text;
  ThisBaud : string[4];
  ThisDay  : DayType;
  ThisTime : Time;
  ThisTag  : string[15];
  Tags     : array[1..10] of EventRec;
  TagFile  : File of EventRec;
  PrmInfo, EvtInfo : SearchRec;

procedure CheckCommandLine;
begin
  if ParamCount <> 1 then
  begin
    writeln('Syntax:  QkTmBPS Tag_Line');
    Halt;
  end;
  ThisTag := StUpCase(ParamStr(1));
end;

procedure Initialize;
begin
  EventOK  := false;
  ThisBaud := '';
  ThisDay  := DayOfWeek(Today);
  ThisTime := CurrentTime;
  for x := 1 to 10 do
  begin
    Tags[x].Tag := '';
    for y := 1 to 10 do
    begin
      Tags[x].Commands[y].Baud  := '';
      Tags[x].Commands[y].Day   := '';
      Tags[x].Commands[y].STime := 0;
      Tags[x].Commands[y].ETime := 0;
    end;
  end;
end;

procedure WritePrmFile;
var
  Begun          : boolean;
  TagLine : byte;
  sStart, sEnd   : DateString;
begin
  writeln;
  writeln('Reading QkTmBPS.Evt -> Compiling QkTmBPS.Prm');
  assign(F, 'QkTmBPS.Evt');
  {$I-}
  reset(F);
  {$I+}
  if IOResult <> 0 then
  begin
    writeln('Could NOT find QkTmBPS.Evt - Event Control File!');
    Halt;
  end;
  assign(TagFile, 'QkTmBPS.Prm');
  rewrite(TagFile);
  TagNo := 1; TagLine := 0; Begun := false;
  while (TagNo <= 10) AND NOT EOF(F) do
  begin
    readln(F, sTemp);
    if (sTemp <> '') AND (sTemp[1] <> ';') then
    begin
      sTemp := StUpCase(sTemp);
      if Begun then
      begin
        if sTemp <> 'END_DEF' then
        begin
          inc(TagLine);
          if TagLine <= 10 then
          begin
            Tags[TagNo].Commands[TagLine].Baud  := ExtractWord(1, sTemp, [' ']);
            Tags[TagNo].Commands[TagLine].Day   := ExtractWord(2, sTemp, [' ']);
            sStart := ExtractWord(3, sTemp, [' ']);
            sEnd   := ExtractWord(4, sTemp, [' ']);
            Tags[TagNo].Commands[TagLine].STime := TimeStringToTime('hh:mm', sStart);
            Tags[TagNo].Commands[TagLine].ETime := TimeStringToTime('hh:mm', sEnd);
          end;
        end
        else
        begin
          Begun := false;
          TagLine := 0;
          write(TagFile, Tags[TagNo]);
          inc(TagNo);
        end;
      end
      else
        if sTemp = 'BEGIN_DEF' then
        begin
          Begun := true;
          readln(F, sTemp);
          sTemp := Trim(sTemp);
          sTemp := StUpCase(sTemp);
          Tags[TagNo].Tag := sTemp;
        end;
    end;
  end;
  SetFTime(TagFile, EvtInfo.Time);
  close(F);
  close(TagFile);
  writeln('Done.');
end;

procedure CheckPrmFile;
begin
  FindFirst('QkTmBPS.Evt', AnyFile, EvtInfo);
  if DosError = 0 then
  begin
    FindFirst('QkTmBPS.Prm', AnyFile, PrmInfo);
    if DosError <> 0 then WritePrmFile
    else
      if (PrmInfo.Time <> EvtInfo.Time) then WritePrmFile;
  end
  else
  begin
    writeln('Could NOT find QkTmBPS.Evt - Event Control File!');
    Halt;
  end;
end;

procedure ReadPrmFile;
begin
  assign(TagFile, 'QkTmBPS.Prm');
  {$I-}
  reset(TagFile);
  {$I+}
  if IOResult <> 0 then
  begin
    writeln('Could NOT find QkTmBPS.Prm - Event Parameters File!');
    Halt;
  end;
  TagNo := 0;
  while (TagNo < 10) AND NOT EOF(TagFile) do
  begin
    inc(TagNo);
    read(TagFile, Tags[TagNo]);
  end;
  close(TagFile);
end;

procedure ReadDorInfo;
begin
  assign(F, 'DorInfo1.Def');
  {$I-}
  reset(F);
  {$I+}
  if IOResult <> 0 then
  begin
    writeln('Could NOT find DorInfo1.Def File!');
    Halt;
  end;
  for x := 1 to 4 do ReadLn(F);
  ReadLn(F, sTemp);
  close(F);
  ThisBaud := ExtractWord(1, sTemp, [' ']);
end;

function CheckTime(ThisTime, StarT, EndT : Time) : boolean;
begin
  CheckTime := (ThisTime >= StarT) AND (ThisTime <= EndT);
end;

procedure ExitWithErrorLevel;
begin
  for x := 1 to 10 do
  begin
    if ThisTag = Tags[x].Tag then
    begin
      for y := 1 to 10 do
      begin
        with Tags[x].Commands[y] do
        begin
          if Baud = ThisBaud then
          begin

            if Day = 'ALL' then
              if CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'WK' then
              case ThisDay of
                Sunday, Monday, Tuesday,
                Wednesday, Thursday, Friday :
                  if CheckTime(ThisTime, STime, ETime) then Halt(0);
              end;

            if Day = 'WKEND' then
              case ThisDay of
                Saturday, Sunday : if CheckTime(ThisTime, STime, ETime) then
                  Halt(0);
              end;

            if Day = 'MON' then
              if (ThisDay = Monday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'TUE' then
              if (ThisDay = Tuesday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'WED' then
              if (ThisDay = Wednesday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'THU' then
              if (ThisDay = Thursday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'FRI' then
              if (ThisDay = Friday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'SAT' then
              if (ThisDay = Saturday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);

            if Day = 'SUN' then
              if (ThisDay = Sunday) AND
                 CheckTime(ThisTime, STime, ETime) then Halt(0);
          end;
        end;
      end;
    end;
  end;
  Halt(1);
end;

begin
  CheckCommandLine;
  Initialize;
  CheckPrmFile;
  ReadPrmFile;
  ReadDorInfo;
  ExitWithErrorLevel;

{$IFDEF DEBUG}
  for x := 1 to 10 do
  begin
    ClrScr;
    writeln('Tag # ',x,'   Current Baud Rate: ', ThisBaud);
    writeln('Tag Name: ', Tags[x].Tag);
    writeln('Commands: ');
    for y := 1 to 10 do
    begin
      write(Tags[x].Commands[y].Baud   , '  ');
      write(Tags[x].Commands[y].Day    , '  ');
      write(Tags[x].Commands[y].STime  , '  ');
      writeln(Tags[x].Commands[y].ETime, '  ');
    end;
    readln;
  end;
{$ENDIF}
end.